Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/buttons/btndmo/form1.frm

Text File | 1995-10-01 | 8KB | 261 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Button Demo"
   ClientHeight    =   4890
   ClientLeft      =   1110
   ClientTop       =   1515
   ClientWidth     =   5640
   Height          =   5295
   Left            =   1050
   LinkTopic       =   "Form1"
   ScaleHeight     =   4890
   ScaleWidth      =   5640
   Top             =   1170
   Width           =   5760
   Begin VB.PictureBox Picture1
      BackColor       =   &H00FFFF00&
      Height          =   495
      Index           =   4
      Left            =   60
      ScaleHeight     =   435
      ScaleWidth      =   2295
      TabIndex        =   4
      Top             =   2580
      Width           =   2355
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H00FFFF00&
      Height          =   495
      Index           =   3
      Left            =   60
      ScaleHeight     =   435
      ScaleWidth      =   2295
      TabIndex        =   3
      Top             =   1920
      Width           =   2355
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H00FFFF00&
      Height          =   495
      Index           =   2
      Left            =   60
      ScaleHeight     =   435
      ScaleWidth      =   2295
      TabIndex        =   2
      Top             =   1260
      Width           =   2355
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H00FFFF00&
      Height          =   495
      Index           =   1
      Left            =   60
      ScaleHeight     =   435
      ScaleWidth      =   2295
      TabIndex        =   1
      Top             =   660
      Width           =   2355
   End
   Begin VB.CommandButton Command2
      Caption         =   "Appearance"
      Height          =   375
      Left            =   540
      TabIndex        =   5
      Top             =   3240
      Width           =   1215
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H00FFFF00&
      Height          =   495
      Index           =   0
      Left            =   60
      ScaleHeight     =   435
      ScaleWidth      =   2295
      TabIndex        =   0
      Top             =   60
      Width           =   2355
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   $"FORM1.frx":0000
      Height          =   975
      Index           =   3
      Left            =   2520
      TabIndex        =   10
      Top             =   3720
      Width           =   3015
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   $"FORM1.frx":00AD
      Height          =   1170
      Index           =   2
      Left            =   2520
      TabIndex        =   9
      Top             =   2400
      Width           =   2985
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   $"FORM1.frx":0188
      Height          =   975
      Index           =   1
      Left            =   2520
      TabIndex        =   8
      Top             =   1260
      Width           =   2970
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   $"FORM1.frx":0251
      Height          =   780
      Index           =   0
      Left            =   2520
      TabIndex        =   7
      Top             =   300
      Width           =   3135
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "NOTES:"
      Height          =   195
      Left            =   2520
      TabIndex        =   6
      Top             =   60
      Width           =   600
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'The class array is dimensioned to the
'the same size as the picturebox control
'array used as containers for the buttons.
Private clsButtons(4) As New CButtons

Private Sub Command2_Click()
    Static Index
    Const BTN_FLAT = 1
    Const BTN_3D = 2

    'By using a static variable we can
    'change the appearance property of the
    'button classes separately, in sequence
    'every time the user presses this button

    If clsButtons(Index).Appearance = 1 Then
        clsButtons(Index).Appearance() = BTN_3D
    Else
        clsButtons(Index).Appearance() = BTN_FLAT
    End If

    If Index = UBound(clsButtons) Then
        Index = 0
    Else
        Index = Index + 1
    End If
End Sub

Private Sub Form_Load()
    Dim i%
    'The button class contains its own 'Custom' initialzation
    'procedure.  This is necessary because the vb default
    'implementation of the Class_Initialize event does not allow
    'for the passing of parameters.

    'We need to pass the container to the class during
    'initialzation.  This is because the class assigns
    'the picturebox to a private picturebox variable; which
    'it references throughout the class code making the
    'code itself generic/internal to the class and allows
    'for portability between vb apps.

    'Once the picturebox is assigned, then we can use all
    'the features of the class.  The default number of buttons
    'is one; in this demo we assign an incrementing number
    'to demonstrate the flexibility of the Buttons property.
    'As shown in the loop, the picturebox is first assigned,
    'then the number of buttons is set.

    For i% = LBound(clsButtons) To UBound(clsButtons)
        Call clsButtons(i%).InitializeClass(Picture1(i%))
        clsButtons(i%).Buttons() = i + 2
    Next i%

    'Center the form
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i%
    'This is required for design mode in VB to
    'force the class to terminate when the form
    'is unloaded
    For i% = LBound(clsButtons) To UBound(clsButtons)
        Set clsButtons(i%) = Nothing
    Next i%
End Sub


Private Sub Picture1_DblClick(Index As Integer)
    'Some users prefer the option to allow no buttons
    'to be selected.  This can easily be achieved by
    'setting the Value property to zero.  For this
    'example, I allow the user to do this by double
    'clicking anywhere on the container.

    clsButtons(Index).Value() = 0
End Sub

Private Sub Picture1_GotFocus(Index As Integer)
    'The buttons need to be redrawn to update
    'the button images to show that the container
    '(i.e. the buttons) now have the focus

    Call clsButtons(Index).Refresh
End Sub

Private Sub Picture1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    'The button class subclasses this event.

    'In this demo, the class implements the functionality
    'of the direction keys as per a normal option button
    'group.

    Call clsButtons(Index).KeyDown(KeyCode, Shift)
End Sub


Private Sub Picture1_LostFocus(Index As Integer)
    'The buttons need to be redrawn to update
    'the button images to show that the container
    '(i.e. the buttons) does not have the focus

    Call clsButtons(Index).Refresh
End Sub


Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'The button class subclasses this event.

    'In this demo, the class checks for mousehits on
    'the buttons and changes focus/value to the button
    'that is hit.

    Call clsButtons(Index).MouseDown(Button, Shift, X, Y)
End Sub

Private Sub Picture1_Paint(Index As Integer)
    'Redraw the buttons
    Call clsButtons(Index).Refresh
End Sub